home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok44.lha / Length / Length.mod < prev    next >
Text File  |  1993-08-15  |  3KB  |  119 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    Length
  4.     :Contents.   Gibt die Länge eines Directorys aus
  5.     :Author.     Steffen Reith
  6.     :Address.    Hessenstr. 64, D-8700 Würzburg
  7.     :Language.   Modula-2
  8.     :Translator. M2Amiga A+L V3.2d
  9.  
  10. **********************************************************************)
  11.  
  12. (* $R- $F- *)
  13. MODULE Length;
  14.  
  15. (* Length V1.2    5.8.1989           *)
  16. (* New with HomeDirLength  22.1.1990 *)
  17.  
  18. FROM Arguments IMPORT NumArgs,GetArg;
  19. FROM Dos       IMPORT Examine,ExNext,Lock,accessRead,FileLockPtr,FileLock,
  20.                       FileInfoBlock,FileInfoBlockPtr,UnLock;
  21. FROM InOut    IMPORT WriteInt,WriteString,WriteLn,Write;
  22. FROM SYSTEM    IMPORT ADR,ADDRESS;
  23. FROM Arts      IMPORT Assert;
  24. FROM Heap      IMPORT Allocate,Deallocate;
  25. FROM Str       IMPORT Concat,Length;
  26.  
  27. CONST Len=01FFH;
  28.  
  29. TYPE String=ARRAY[0..Len] OF CHAR;
  30.  
  31. VAR Name,PrgName:String;
  32.     NDir,NFile,N,L:INTEGER;
  33.  
  34. PROCEDURE DLength(VAR Name:ARRAY OF CHAR;N:INTEGER):LONGINT;
  35.  
  36. VAR FilePtr,Old:FileLockPtr;
  37.     InfoPtr:FileInfoBlockPtr;
  38.     Summe,Size:LONGINT;
  39.     Path:String;
  40.     Command1,Command2:ARRAY[0..3] OF CHAR;
  41.  
  42. BEGIN
  43.  Summe:=0;
  44.  Allocate(ADDRESS(InfoPtr),SIZE(FileInfoBlock));
  45.  (* Speicherblock wird im Fehlerfall von Storage zurueckgegeben *)
  46.  Assert(InfoPtr#NIL,ADR('Cant allocate FileInfoBlock !!'));
  47.  FilePtr:=Lock(ADR(Name),accessRead);
  48.  Assert(FilePtr#NIL,ADR('Wrong directory !!'));
  49.  Assert(Examine(FilePtr,InfoPtr),ADR('Can not Examine File !!'));
  50.  INC(NDir);
  51.  Assert(InfoPtr^.dirEntryType>=0,ADR('Only directories are allowed !!'));
  52.  Command1:=' [1m';Command1[0]:=CHAR(27);
  53.  Command2:=' [0m';Command2[0]:=CHAR(27);
  54.  LOOP
  55.   IF NOT(ExNext(FilePtr,InfoPtr)) THEN EXIT END;
  56.   (* Dateiinformationen holen !! *)
  57.   IF (InfoPtr^.dirEntryType>0) THEN
  58.    Path:='';
  59.    Concat(Path,Name);
  60.    IF ((Name[0]#CHAR(0)) AND ((N>1) OR (Name[Length(Name)-1]#':'))) THEN
  61.     Concat(Path,'/')
  62.    END;
  63.    Concat(Path,InfoPtr^.fileName);
  64.    Size:=DLength(Path,N+1);
  65.    WriteString(Command1);
  66.    WriteString(Path);
  67.    WriteString(Command2);
  68.    WriteString(' ==> ');
  69.    WriteInt(Size,0);WriteLn;
  70.    Summe:=Summe+Size
  71.   ELSE
  72.    Summe:=Summe+InfoPtr^.size;
  73.    INC(NFile)
  74.   END
  75.  END;
  76.  UnLock(FilePtr);
  77.  Deallocate(ADDRESS(InfoPtr));
  78.  RETURN Summe
  79. END DLength;
  80.  
  81. PROCEDURE PrintErg(VAR Name:String);
  82.  
  83. VAR Size:LONGINT;
  84.  
  85. BEGIN
  86.  Size:=DLength(Name,1);
  87.  WriteLn;
  88.  WriteString('There are ');
  89.  WriteInt(Size,0);
  90.  WriteString(' Bytes in ');
  91.  WriteInt(NDir,0); (* Global *)
  92.  WriteString(' directories and ');
  93.  WriteInt(NFile,0); (* Global *)
  94.  WriteString(' Files !!');
  95.  WriteLn
  96. END PrintErg;
  97.  
  98. BEGIN
  99.  NDir:=0;
  100.  NFile:=0;
  101.  N:=NumArgs();
  102.  IF (N=1) THEN
  103.   GetArg(1,Name,L);
  104.   IF Name[0]='?' THEN
  105.    GetArg(0,PrgName,L);
  106.    WriteString(PrgName);
  107.    WriteString(' DIR');
  108.    WriteLn;
  109.   ELSE
  110.    PrintErg(Name)
  111.   END
  112.  ELSIF (N=0) THEN
  113.   Name:='';
  114.   PrintErg(Name);
  115.  ELSE
  116.   WriteString('Illegal number of arguments !!');WriteLn
  117.  END;
  118. END Length.
  119.